00100	C***** BEAMS,  XNOTE, BAUTO, UPDATE *******
00200		SUBROUTINE BEAMS
00300		COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,DMAX,
00400		1 UMAX,AA,JMAX,X,Y,BB,RNX(1982)
00500		1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
00600		1 /PTR/PWDS(250),ITEM,LL,IS,IX
00700		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00800		COMMON RJB,JAZ,CENTR,JBZ,RJQ(20),JQ(20)
00900		COMMON/SCX/RHY(4),JALPHA(20),JX,U,JZ,IRHY,JD,KA,KB,IZ
01000		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
01100		1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
01200		1 /STF/RSTFAC(8),RSTJC
01300		DIMENSION R(10,80)
01400		EQUIVALENCE (R,RN(3001)),(STEM,RN(2999))
01500		DATA BX/25./,BY/.5/,DFAC/4./,CURV/1./
01600	C  THESE ARE USED TO DETERMINE CURVE OF SLURS AT 63 (21700)
01700	
01800		INVT=-1
01900		IF(MODE.EQ.3)GO TO 25
02000		IF(REND.NE.0)GO TO 25
02100		REND=3
02200	25	DO 1500 K=1,72
02300		IF(INP(K).EQ.'B')GO TO 22
02400	C  B=AUTOMATIC BEAMS.
02500		IF(INP(K).NE.'*')GO TO 1500
02600	15	INP(72)='*'
02700		GO TO 500
02800	1500	IF(INP(K).EQ.ISEMI)GO TO 500
02900		GO TO 15
03000	C ABOVE FOR 2ND LNE OF INPUT. IF LNS ENDS WITHOUT * OR ;, IT PUTS IN *
03100	22	REREAD F78F,A,B
03200	C  TYPE '2B' OR '3B' ETC. FOR AUTOMATIC BEAMS. (2=DUPLE  3=TRIPLE)
03300		IF(IREAD.NE.0)A=B
03400		A=A/2.
03500	C  '2'=1  '3'=1.5
03600		IF(STEM)STEM=0
03700	C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
03800		K=0
03900		N=0
04000		J=0
04100		INP(72)='*'
04200	C  PICKS UP RHYTHM FROM TIME WHEN MODE=2 (NOW IT =4)
04300	122	K=K+1
04400		L=K
04500	222	C=ABS(V(K))
04600		IF(C.EQ.4./88.)GO TO 522
04700	C  CATCHES 88TH NOTES (GRACE NOTES)???
04800		IF(V(K).GT.0)GO TO 922
04900	1022	N=N+1
05000	C  SUBTRACTS NUMB. FOR REST.
05100		IF(C.GE.A)GO TO 1222
05200	1322	L=L+1
05300		GO TO 422
05400	1222	IF(AMOD(C,A).NE.0)GO TO 622
05500		IF(K-L.LE.1)GO TO 522
05600		L=L+1
05700		GO TO 722
05800	922	IF(C.EQ.A)GO TO 522
05900	422	IF(K.EQ.IRHY)GO TO 322
06000		K=K+1
06100		B=V(K)
06200		IF(B.NE.4./88.)C=C+ABS(B)
06300		IF(B)GO TO 1022
06400		IF(C.LT.A-.0001)GO TO 422
06500		IF(C.LT.A+.0001)GO TO 722
06600	C  .0001 FOR ROUNDOFF PROBLEMS
06700	1922	C=AMOD(C,A)
06800		IF(K-L.LE.1)GO TO 622
06900		CALL BAUTO(J,L,K-1,N)
07000	622	L=K
07100		IF(ABS(V(K)).GE.A.OR.C.EQ.0)L=L+1
07200		GO TO 422
07300	722	IF(K.EQ.L)GO TO 522
07400	1722	DO 1422 IT=L,K
07500		B=V(IT)
07600	1422	IF(B.GT..75.OR.B.EQ.4./6.)GO TO 1522
07700	C WON'T PUT BEAMS WHERE NOT LOGICAL. CATCHES QUINTS AND SEXT'S.
07800		IF(V(L)+V(K).LT.A+.0001)CALL BAUTO(J,L,K,N)
07900	C  DOES ONLY DUPLES AT THIS POINT.
08000	522	IF(K.LT.IRHY)GO TO 122
08100	
08200	322	IF(J.EQ.0)RETURN
08300	C  NO BEAMS - SO GO BACK.
08400		DO 822 K=J+1,68
08500	C  USES ONLY 68 SLOTS IN 'V'
08600	822	V(K)=0
08700		J=0
08800		GO TO 27
08900	1522	IF(IT-1.GT.L)GO TO 1622
09000	1822	L=IT+1
09100		IF(L.LT.K)GO TO 1722
09200		GO TO 522
09300	1622	CALL BAUTO(J,L,IT-1,N)
09400		GO TO 1822
09500	C  ALL THIS ↑↑ FOR QUARTERS IN TRIPLE TIME UNITS!
09600	27	DO 26 L=1,50
09700	26	VX(L)=V(L)
09800	C  BECAUSE MODE 3 IS NOW ACCENTS, ETC.
09900		GO TO 511
10000	
10100	500	REREAD F78F,VX
10200		J=0
10300		IF(IREAD.NE.0)J=1
10400	511	J=J+1
10500		N=VX(J)
10600	C  SKIPS LINE #S.
10700		JMP=1
10800	505	L=0
10900		K=0
11000		POS=-10.
11100		IF(MODE.EQ.3)GO TO 5030
11200	C  MODE 3 IS FOR ACCENTS ETC.
11300	CC	IF(N.GT.100)GO TO 161
11400		RN(8+IS)=0
11500		RN(9+IS)=0
11600		IT=0
11700		BRK=AMOD(VX(J),1.)*10.
11800		IF(BRK.EQ.0)GO TO 503
11900	C NEXT FOR TRIPL. BRACKET, ETC.  ADD DESIRED .NUM TO 1ST NUM.
12100		RN(9+IS)=BRK
12300		GO TO 5030
12400	503	IF(N.GT.0)GO TO 5031
12500		IT=-1
12600		POS=-1.3
12700	C  -1= SLUR INTO 1ST NOTE.
12800	C  SETS POS OF LFT SIDE (-10+9, THEN +2)
12900		GO TO 5060
13000	5031	IF(N.LE.80)GO TO 5030
13100		POS=202
13200		GO TO 550
13300	C  -1=1ST SLUR FROM NO NOTE; 99= LAST, TO NO NOTE
13400	5030	L=L+1
13500	502	K=K+1
13600		IF(R(1,K).NE.1.)GO TO 502
13700	C  IS IT A NOTE?
13800		P=R(2,K)
13900		IF(P.EQ.POS)GO TO 502
14000	C  SKIPS DBLSTPS
14100		POS=P
14200	506	IF(L.NE.N)GO TO 5030
14300	5060	IF(MODE.EQ.3)GO TO 30
14400	C  NOW SLUR STARTS
14500		IF(JMP)GO TO 504
14600	C  JMP=-1 MEANS END NOTE OF GROUP
14700		J=J+1
14800		NN=VX(J)
14900	CC	IF(MODE.NE.5.OR.STEM)GO TO 5061
15000	CC	M=R(5,K)-20.
15100	CC	IF((NN.AND.M.GE.0).OR.(M.AND.NN.GE.0))NN=-NN
15200		IF(STEM.OR.(MODE.EQ.4.AND.STEM.EQ.0))GO TO 5061
15300	C  AUTOMATIC DIP DIRECTION FOR SLURS WITH AUTO. BEAMS.
15400		A=19.-R(5,K)
15500		IF((NN.AND.A.GT.0).OR.(A.AND.NN.GT.0))NN=-NN
15600	5061	MK=N
15700		N=NN
15800		IF(N)N=-N
15900		M=K
16000		JA=2
16100		JB=4
16200		KN=K
16300		RB=0
16400		IF(MODE.EQ.4)GO TO 550
16500		IBR=6
16600	C  6=SLUR, 7=BRACK. FOR TRIPLETS, ETC.
16700		IF(STEM.GE.0)NN=-NN
16800		IF(IT)GO TO 550
16900	C  IT=-1=SLUR INTO 1ST NOTE.
17000		A=XNOTE(K)
17100	C XNOTE IS AMOD(R(4,K),100.)
17200	C  SAVES LEVEL OF 1ST NOTE.
17300	504	RB=2
17400		B=AMOD(R(6,K),1.0)
17500		IF(B.GE.0.5)RB=4.
17600		IF(B.EQ.0.4)RB=6.
17700	C   THESE ARE FOR >(.5) AND ∧(.4) ACCENTS
17800		IF(NN)RB=-RB
17900	C  DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
18000	550	RN(JA+IS)=POS
18100		RN(JB+IS)=XNOTE(K)+RB
18200		JA=6
18300		JB=5
18400	C  MK=# OF 1ST NOTE, N=END NOTE NOW
18500		JMP=-JMP
18600		IF(JMP.GT.0)GO TO 1503
18700	C  GO FIND RT. SIDE OF SLUR
18800		IF(N.LE.MK)N=MK+1
18900	C  PICKS UP TYPO ERRORS
19000		JK=0
19100		IF(R(7,K).GE.10)JK=-1
19200	C  CHECKS FOR DOT AFTER 1ST NOTE -- FOR TIES.
19300		GO TO 503
19400	
19500	1503	RN(3+IS)=STAFF
19600		IF(MODE.EQ.4)GO TO 35
19700		RN(8+IS)=-1
19800		RN(1+IS)=8
19900		IF(IT)RN(4+IS)=RN(5+IS)
20000		NN=-NN
20100	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
20200		IF(MK.EQ.IRHY.OR.N.EQ.1)GO TO 61
20300		IF(((XNOTE(K).NE.A.OR.N-MK.GT.1).AND.IT.GE.0.
20400		1 ).OR.IT)GO TO 60
20500	C  .N. WAS .KQ. 12/73
20600	C  JUMP IF NOT ADJACENT NOTE AT SAME PITCH AND NOT 1ST OR LAST.
20700	61	C=9
20800		IF(JK)C=12
20900		IF(RN(6+IS)-RN(2+IS)-C*RSTJC)GO TO 65
21000		IF(IT)A=XNOTE(K)
21100		A=A+.7
21200		IF(NN.GT.0)A=A-1.4
21300	C  TO RAISE OR LOWER IT .5
21400		RN(4+IS)=A
21500		RN(5+IS)=A
21600		B=-2
21700		IF(JK)B=-3
21800	C  JK=-1 WHEN NOTE IS DOTTED.
21900	C THIS PUTS TIE BETWEEN (NOT ABOVE OR BELOW) NTS. NO STEM CHNG.
22000		RN(8+IS)=B
22100		GO TO 65
22200	CC161	J=J+1
22300	CC	K=VX(J)
22400	CC	M=N-100
22500	C  THIS WILL DIRECT STEMS ON NOTES M THROUGH K. IF -K,STEMS DN.
22600	CC	NN=K
22700	CC	IF(K)K=-K
22800	
22900	60	IF(STEM.EQ.0)GO TO 508
23000	C  NEXT IS STEM INVERTER.  SKIP IF AUTOMATIC BEAMS.
23100		JB=1
23200		RB=10.
23300		IF(NN)GO TO 509
23400	C  IF NN IS NEG. NOW IT MEANS STEM DOWN.(DIP IS UP!)
23500		RB=-RB
23600		JB=2
23700	509	DO 507 L=M,K
23800		IF(R(1,L).NE.1.)GO TO 507
23900		JA=R(5,L)/10.
24000		IF(JA.NE.JB)GO TO 507
24100		R(5,L)=R(5,L)+RB
24200		INVT=0
24300	C**********************************************
24400	507	CONTINUE
24500	508	IF(N.GT.100)GO TO 514
24600	C  JUMP IF ONLY REVERSING STEMS.
24700		GO TO 200
24800	62	IF(NN)GO TO 64
24900		IF(A.EQ.DMAX)GO TO 65
25000		AA=B-DMAX
25100		GO TO 63
25200	65	AA=0
25300		GO TO 63
25400	64	IF(A.EQ.UMAX)GO TO 65
25500		AA=UMAX-B
25600	63	RA=RN(6+IS)
25700		RB=RN(2+IS)
25800		X=CURV+(RA-RB)/BX
25900		IF(AA.GT.0)X=X+AA*BY
26000		IF(BRK.EQ.0)GO TO 66
26100		RN(8+IS)=1
26200		RN(2+IS)=RB-.6
26220		RB=R(2,K+1)
26225	C  K=END NOTE OF GROUP
26230		IF(K.EQ.IRHY)RB=200.
26240	C  ASSUMES LINE STOPS AT 200. (IT COULD BE LONGER!!)
26250		RN(6+IS)=RA+(RB-RA)/2.
26400		IBR=7
26500	C  CHECK THESE NUMBERS↑↑↑↑
26600		B=RN(4+IS)
26700		BB=RN(5+IS)
26800		RA=1
26900		IF(A.LT.-1)RA=2.5
27000	C  CHANGES HEIGHT.  MAKES BRACK. IF N>100.
27100		IF(NN.GT.0)RA=-RA
27200		RN(4+IS)=B+RA
27300		RN(5+IS)=BB+RA
27400		X=2
27500	66	IF(NN.GT.0)X=-X
27600	510	RN(7+IS)=X
27700		IF(MODE.NE.4)GO TO 2514
27800		RN(9+IS)=0
27900		RN(10+IS)=0
28000		RN(IS+11)=-1
28100		CALL UPDATE(9)
28200		IF(JB)CALL BMX(RA)
28300		GO TO 514
28400	2514	CALL UPDATE(IBR)
28500	514	J=J+1
28600		N=VX(J)
28700		IF(MOD(N,100).GT.IRHY)N=0
28800		IF(N.NE.0)GO TO 505
28900		IF(J.LT.50)GO TO 514
29000	C  SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
29100		IF(INP(72).NE.'*')GO TO  552
29200		IF(INVT)RETURN
29300		INVT=IS
29400		CALL NEWR
29500		IS=INVT
29600		RETURN
29700	552	IF(IREAD.NE.0)GO TO 3501
29800		CALL TYPE
29900		GO TO 25
30000	3501	READ(22,2501)J,INP
30100	C  TO READ MORE THAN 2 LINES.
30200		GO TO 25
30300	C  FOR 2ND LINE.
30400	2501	FORMAT(I,72A1)
30500	
30600	
30700	35	RA=10.
30800	C  RA WILL=# OF TAILS,  KN=1ST NOTE, K=LAST ('MOD' FOR DOTTED NOTES.)
30900		RN(1+IS)=9
31000		JMAX=0
31100		IF(N-MK.EQ.1)JMAX=-1
31200		DMAX=100.
31300		UMAX=-DMAX
31400	C  FOR AUTO. BEAMS
31500	
31600		JB=0
31700		DO 2 L=KN,K
31800	12	IF(R(1,L).NE.1.OR.R(5,L).LT.10.)GO TO 2
31900	C  SKIPS NON-NOTES AND DBLSTPS
32000		RB=R(4,L)
32100		IF(ABS(RB).GE.100)GO TO 2
32200	C  SKIPS GRACE NOTES
32300		IF(RB.GT.UMAX)UMAX=RB
32400		IF(RB.LT.DMAX)DMAX=RB
32500	C  FOR AUTO. BEAMS
32600		RB=AMOD(R(7,L),10.0)
32700	112	IF(RA.EQ.RB)GO TO 2
32800		JB=-1
32900	C   FLAG FOR MIXED NUM. OF BEAMS
33000		IF(RB.LT.RA.AND.RB.NE.0)RA=RB
33100	2	CONTINUE
33200	C  ABOVE FINDS SMALLEST # OF TAILS.  NEXT FOR HGTS.
33300	C  ABOVE IS POS.2
33400		IF(STEM.EQ.0.AND.UMAX+DMAX.GE.14)NN=-1
33500	CXX	IF(STEM.GT.0)NN=10.-STEM
33600	C  SETS AUTO. BEAMS' STEM DIRECTION.
33700		X=10
33800		IF(NN)X=20
33900		X=X+RA
34000	C  # OF BEAMS.  IT'S PUT IN  DOWN BELOW 550.
34100	200	A=XNOTE(KN)
34200	C   A=NOTE 1.
34300		UMAX=A
34400		DMAX=A
34500	C  UP MAX. NOTE #, DOWN MAX. NOTE #.
34600	103	DO 3 M=KN,K
34700		IF(R(1,M).NE.1.OR.ABS(R(4,M)).GE.100)GO TO 3
34800	C  SKIPS NON-NOTES
34900	7	B=XNOTE(M)
35000		IF(STEM.GT.0.OR.(MODE.EQ.5.AND.STEM.EQ.0))GO TO 55
35100		Y=R(5,M)
35200	33	IF(NN.GT.0.)GO TO 5
35300	C  JUMP IF STEM UP
35400		IF(Y.GE.20..OR.Y.LT.10.)GO TO 55
35500		R(5,M)=Y+10.
35600		GO TO  551
35700	5	IF(Y.LT.20.)GO TO 55
35800		R(5,M)=Y-10.
35900	C************************
36000	C    STEM UP
36100	551	INVT=0
36200	55	IF(B.LT.UMAX)GO TO 13
36300		UMAX=B
36400		IF(JMAX.OR.M.EQ.KN.OR.M.EQ.K)GO TO 3
36500		UMAX=UMAX+1
36600		GO TO 3
36700	13	IF(B.GT.DMAX)GO TO 3
36800		DMAX=B
36900		IF(JMAX.OR.M.EQ.KN.OR.M.EQ.K)GO TO 3
37000		DMAX=DMAX-1
37100	3	CONTINUE
37200	C  LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
37300	4	IF(MODE.EQ.5)GO TO 62
37400		AA=A
37500		BB=B
37600		C=1
37700		IF(X.LT.20.)GO TO 48
37800	C  JUMP IF STEM IS UP
37900		CALL EXCH(AA,BB)
38000		C=-C
38100		CALL EXCH(UMAX,DMAX)
38200	48	IF(AA.LT.BB)GO TO 45
38300		IF(UMAX.EQ.A)GO TO 46
38400	47	A=UMAX-C
38500		B=A
38600		GO TO 444
38700	46	IF(UMAX.GT.AA)GO TO 47
38800		GO TO 49
38900	45	IF(UMAX.NE.B)GO TO 47
39000	49	A=AA
39100		B=BB
39200		IF(X.GE.20)CALL EXCH(A,B)
39300	
39400	444	RN(3+IS)=STAFF 
39500	446	DIS=(RN(IS+6)-RN(IS+2))/DFAC
39600	C  FOR TILT LATER -- DFAC IS IN DATA
39700		IF(ABS(A-B).LT.DIS)GO TO 14
39800		C=C*DIS
39900	C  NEW TILT ROUTINE.  CONSIDERS DISTANCE:HEIGHT
40000	C  LIMITS SLOPE OF BEAM
40100		IF(X.GE.20)GO TO 141
40200		IF(B.GT.A)GO TO 140
40300	142	B=A-C
40400		GO TO 14
40500	141	IF(B.GT.A)GO TO 142
40600	140	A=B-C
40700	14	RN(4+IS)=A
40800		RN(5+IS)=B
40900	C   MAKES HORIZONTAL BEAMS IF PATTERN IS UP-DOWN.
41000		RN(6+IS)=R(2,K)
41100	C  ABOVE IS POS.2
41200		GO TO 510
41300	
41400	C   NEXT IS FOR ACCENTS AND OTHER MARKS
41500	
41600	30	CALL MARKS(RA)
41700		J=J+1
41800		IF(RA.EQ.99)RA=VX(J)
41900	C  IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
42000	C    OF ACCENT WILL BE INVERTED.
42100		RB=R(6,K)
42200		B=10.
42300		IF(RA.EQ.6)RA=26.
42400	C TEMPORARY CHANGE FOR FERMATA*******
42500		IF(RA.GT.10.)RA=RA/10.
42600		A=ABS(AMOD(RB,1.))
42700		IF(A.EQ.0)GO TO 301
42800		IF(RA.GT.3)GO TO 303
42900		RB=FLOAT(IFIX(RB))
43000		RA=RA+A/10.
43100	C  THIS PUTS 2-DIGIT CODE BEFORE 1-DIGIT CODE.
43200		GO TO 301
43300	303	IF(A.LT..3)GO TO 302
43400		B=100.
43500		GO TO 301
43600	302	B=1000.
43700	301	IF(RB.LT.0)RA=-RA
43800		R(6,K)=RB+RA/B
43900		GO TO 514
44000	C   USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
44100	C  NOTE#,ACCENT#/N,A/N,A*
44200		END
44300	
44400		FUNCTION XNOTE(J)
44500		COMMON/XRN/RN(4000)
44600		DIMENSION R(10,80)
44700		EQUIVALENCE (R,RN(3001))
44800		XNOTE=AMOD(R(4,J),100.)
44900		END
45000	
45100		SUBROUTINE BAUTO(J,L,K,N)
45200	C  FOR AUTOMATIC BEAMS.
45300		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
45400		J=J+2
45500		V(J-1)=L-N
45600		V(J)=K-N
45700		END
45800	
45900		SUBROUTINE UPDATE(I)
46000		COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
46100		RN(IS)=I
46200		IS=IS+I+3
46300		END